This file serves as a companion to the poster Integrating Contemporary Methods in Personality Science to Re-Examine the Trait Theory of Voice Disorders presented at Fall Voice 2024.
Important note: to reduce the file size and the time required to render the document, we will import the combined figures that display the results as a png rather than generating them within this document.
library(tidyverse, quietly = T)
library(lavaan)
library(semTools)
library(gt)
library(kableExtra)
library(ggpubr)
library(egg)
library(lubridate)
library(scales)
library(forcats)
library(janitor)
library(cowplot)
#import DF
df4c <- read_csv("../csv_files/df_2024.10.12_combined_voiceCenters_STEP.vhi.less3.csv",
show_col_types = F)
Primary muscle tension dysphonia (MTD) and phonotraumatic vocal hyperfunction (PVH; i.e., benign lesions of the lamina propria) are two of the most common voice disorders. Prior evidence suggests that personality traits may be a risk factor for developing these voice disorders. The Trait Theory of Voice Disorders (TTVD)1 provided a then-contemporary, mechanistically motivated framework to understand the relationships between personality traits and voice disorders. The TTVD asserted that people with MTD are “neurotic introverts” and that people with PVH are “neurotic extraverts.” Although the empirical evidence did not fully support these proposed relationships, Roy et al. found meaningful group differences, supporting the notion that personality may be a risk factor for developing these disorders.2,3 While the MTD group scored higher on Neuroticism and lower on Extraversion, the PVH group demonstrated elevated Extraversion only when compared to the MTD group, and lower scores on Constraint, specifically its facet of Control. The TTVD was pivotal for its time and has continued to influence decades of subsequent research. However, the field of Personality Psychology has continued to grow and evolve. Unfortunately, in its current form, the TTVD is inconsistent with contemporary theories, empirical evidence, and best practices in rigorous personality science. The current project addresses several of these discrepancies to “catch up” with personality science and advance our understanding of personality and voice disorders.
CB5T personality trait hierarchy
The initial TTVD only studied personality traits that are represented by the gray ovals.
To recruit particiapnts, we partnered with 8 different voice clinics around the country.
Partnering voice clinics
Community dwelling individuals experiencing dysphonia would attend their voice evaluation. Upon receiving a diagnosis of primary muscle tension dysphonia (MTD) or a benign lesion of the lamina propria (i.e., phonotraumtic vocal hyperfunction; PVH), clinicians would provide the patient with a recruitment flyer.
Study design
Inclusion criteria:
between 18-60 years old
demonstrated fluency with written and spoken English
receiving a first-time diagnosis of primary MTD or a diagnosis associated with PVH (i.e., vocal fold nodules, polyp(s) with or without a reactive lesion)
Exclusion criteria:
Outside of the 18-60 age range
a concomitant voice or upper airway disorder (except for LPR)
previous history of a diagnosis or voice/speech therapy for a voice or upper airway disorder
Additionally, clinicians at the voice clinics were instructed to recruit classic, unambiguous presentations of the diagnoses of interest. We aimed to minimize/avoid recruiting patients with an ambiguous and/or complex presentations of any of the diagnoses.
Participant reimbursement:
Participants who successfully completed the survey and wished to be reimbursed for participating were given an electronic gift card to their choice of a major retailer (i.e., Amazon, Starbucks, or Target). Initially, reimbursement was set at $10. After a period of slow recruitment, we increased reimbursement to $20 and finally to $40. Most participants who competed the survey received a $40 gift card.
df4c %>%
filter(age>17) %>%
ggplot(aes(age, fill = survey)) +
geom_density(alpha = .7) +
theme_minimal() +
scale_fill_brewer(palette = "YlGnBu") +
labs(title = "Age Distribution",
x = "Age") +
theme(legend.title = element_blank(),
legend.text = element_text(size = 14),
plot.title = element_text(size = 16,
hjust = .5),
axis.title.x = element_text(size = 14,
face = "bold"),
axis.text.x = element_text(size = 14)) -> age_distribution
age_distribution
df4c %>%
filter(age>17) %>%
group_by(survey) %>%
summarise(M = round(mean(age),2),
SD = round(sd(age),2),
Med = median(age),
Min = min(age),
Max = max(age),
n = n()) %>%
gt() %>%
tab_header(title = "Age Distribution by Diagnostic Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(100)) %>%
cols_align("center")
| Age Distribution by Diagnostic Group | ||||||
|---|---|---|---|---|---|---|
| survey | M | SD | Med | Min | Max | n |
| Control | 37.31 | 10.23 | 35.0 | 18 | 60 | 416 |
| MTD | 38.59 | 11.69 | 37.0 | 19 | 60 | 71 |
| PVH | 40.42 | 10.38 | 41.5 | 19 | 56 | 36 |
df4c %>%
group_by(survey, sex) %>%
summarise(n = n()) %>%
mutate(Percent_total = round(n/nrow(df4c)*100,2),
Percent_group = round(n/sum(n)*100,2)) %>%
gt() %>%
tab_header(title = "Sex Distribution - By DX Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(120)) %>%
cols_align("center")
| Sex Distribution - By DX Group | |||
|---|---|---|---|
| sex | n | Percent_total | Percent_group |
| Control | |||
| female | 286 | 54.48 | 68.75 |
| male | 130 | 24.76 | 31.25 |
| MTD | |||
| female | 57 | 10.86 | 80.28 |
| male | 14 | 2.67 | 19.72 |
| PVH | |||
| female | 29 | 5.52 | 76.32 |
| male | 9 | 1.71 | 23.68 |
Figure
df4c %>%
group_by(survey, sex) %>%
summarise(n = n()) %>%
mutate(percent = round(n/sum(n)*100, 2)) %>%
as_tibble() %>%
ungroup() %>%
ggplot(aes(x = survey,
y = percent,
fill = sex)) +
geom_bar(position = position_stack(reverse = T),
stat = "identity",
alpha = 1) +
theme_minimal() +
labs(x = "Group",
y = "Percent",
title = "Sex Distribution") +
theme(plot.title = element_text(size = 16,
hjust = .5),
legend.title = element_blank(),
legend.text = element_text(size = 14),
axis.title = element_text(face = "bold",
size = 14),
axis.text = element_text(size = 14)) +
coord_flip() +
scale_fill_manual(values = rev(c("#41b6c4", "#7fcdbb")),
labels = c("Female", "Male"))
df4c %>%
mutate(gndr_expansive = case_when(
sex == gender ~ "cis",
sex != gender ~ "trans"
)) %>%
select(unique_id, gndr_expansive, survey, sex:gender_other) %>%
group_by(survey, gndr_expansive) %>%
summarise(n = n()) %>%
mutate(percent_total = round(n/nrow(df4c)*100, 2),
percent_group = round(n/sum(n)*100,2)) %>%
gt() %>%
tab_header(title = "Cisgender - By Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(150)) %>%
cols_align("center")
## `summarise()` has grouped output by 'survey'. You can override using the
## `.groups` argument.
| Cisgender - By Group | |||
|---|---|---|---|
| gndr_expansive | n | percent_total | percent_group |
| Control | |||
| cis | 413 | 78.67 | 99.28 |
| trans | 3 | 0.57 | 0.72 |
| MTD | |||
| cis | 66 | 12.57 | 92.96 |
| trans | 5 | 0.95 | 7.04 |
| PVH | |||
| cis | 36 | 6.86 | 94.74 |
| trans | 2 | 0.38 | 5.26 |
df4c %>%
select(unique_id, survey, race_AmericanIndianAlaskaNative:race_pnts, race_Other) %>%
pivot_longer(race_AmericanIndianAlaskaNative:race_Other,
names_to = "Race",
names_prefix = "race_",
values_to = "Checked") %>%
filter(Checked == 1) %>%
group_by(survey, Race) %>%
summarise(n = n()) %>%
mutate(percent_total = round(n/nrow(df4c)*100,2),
percent_group = round(n/sum(n)*100,2)) %>%
# arrange(desc(n)) %>%
gt() %>%
tab_header(title = "Race Distribution By Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(150)) %>%
cols_align("center")
| Race Distribution By Group | |||
|---|---|---|---|
| Race | n | percent_total | percent_group |
| Control | |||
| AmericanIndianAlaskaNative | 5 | 0.95 | 1.28 |
| Asian | 16 | 3.05 | 4.08 |
| BlackAfricanAmerican | 51 | 9.71 | 13.01 |
| NativeHawaiianPacificIslander | 1 | 0.19 | 0.26 |
| Other | 7 | 1.33 | 1.79 |
| pnts | 3 | 0.57 | 0.77 |
| WhiteCaucasian | 309 | 58.86 | 78.83 |
| MTD | |||
| AmericanIndianAlaskaNative | 1 | 0.19 | 1.33 |
| Asian | 6 | 1.14 | 8.00 |
| BlackAfricanAmerican | 12 | 2.29 | 16.00 |
| pnts | 5 | 0.95 | 6.67 |
| WhiteCaucasian | 51 | 9.71 | 68.00 |
| PVH | |||
| AmericanIndianAlaskaNative | 1 | 0.19 | 2.56 |
| Asian | 2 | 0.38 | 5.13 |
| BlackAfricanAmerican | 4 | 0.76 | 10.26 |
| pnts | 2 | 0.38 | 5.13 |
| WhiteCaucasian | 30 | 5.71 | 76.92 |
df4c %>%
group_by(survey, ethnicity) %>%
summarise(n = n()) %>%
mutate(Percent_total = round(n/nrow(df4c)*100, 2),
Percent_group = round(n/sum(n)*100, 2)) %>%
# arrange(desc(n)) %>%
gt() %>%
tab_header(title = "Etnicity Distribution By Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(150)) %>%
cols_align("center")
| Etnicity Distribution By Group | |||
|---|---|---|---|
| ethnicity | n | Percent_total | Percent_group |
| Control | |||
| Hispanic or Latinx/e | 25 | 4.76 | 6.01 |
| NOT Hispanic or Latinx/e | 391 | 74.48 | 93.99 |
| MTD | |||
| Hispanic or Latinx/e | 3 | 0.57 | 4.23 |
| NOT Hispanic or Latinx/e | 65 | 12.38 | 91.55 |
| Unknown / Not Reported | 3 | 0.57 | 4.23 |
| PVH | |||
| Hispanic or Latinx/e | 1 | 0.19 | 2.63 |
| NOT Hispanic or Latinx/e | 36 | 6.86 | 94.74 |
| Unknown / Not Reported | 1 | 0.19 | 2.63 |
df4c %>%
group_by(survey, edu_label) %>%
summarise(n = n()) %>%
mutate(Percent_total = round(n/nrow(df4c)*100,2),
Percent_group = round(n/sum(n)*100,2)) %>%
gt() %>%
tab_header(title = "Education Distribution - By DX Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(120)) %>%
cols_align("center")
| Education Distribution - By DX Group | |||
|---|---|---|---|
| edu_label | n | Percent_total | Percent_group |
| Control | |||
| Associate's degree | 41 | 7.81 | 9.86 |
| Bachelor's degree | 126 | 24.00 | 30.29 |
| Doctoral/terminal degree | 16 | 3.05 | 3.85 |
| High school diploma | 46 | 8.76 | 11.06 |
| Master's degree | 88 | 16.76 | 21.15 |
| No high school education | 1 | 0.19 | 0.24 |
| Prefer not to say | 1 | 0.19 | 0.24 |
| Some college | 81 | 15.43 | 19.47 |
| Some high school education | 2 | 0.38 | 0.48 |
| Trade or technical certificate | 14 | 2.67 | 3.37 |
| MTD | |||
| Associate's degree | 6 | 1.14 | 8.45 |
| Bachelor's degree | 20 | 3.81 | 28.17 |
| Doctoral/terminal degree | 8 | 1.52 | 11.27 |
| High school diploma | 8 | 1.52 | 11.27 |
| Master's degree | 8 | 1.52 | 11.27 |
| Prefer not to say | 2 | 0.38 | 2.82 |
| Some college | 15 | 2.86 | 21.13 |
| Trade or technical certificate | 4 | 0.76 | 5.63 |
| PVH | |||
| Bachelor's degree | 14 | 2.67 | 36.84 |
| Doctoral/terminal degree | 2 | 0.38 | 5.26 |
| High school diploma | 6 | 1.14 | 15.79 |
| Master's degree | 10 | 1.90 | 26.32 |
| Some college | 4 | 0.76 | 10.53 |
| Some high school education | 2 | 0.38 | 5.26 |
Data only available for the voice disorder groups
df4c %>%
filter(survey != "Control") %>%
group_by(survey, singer_yn) %>%
summarise(n = n()) %>%
mutate(percent_group = round(n/sum(n)*100,2)) %>%
gt() %>%
tab_header(title = "Singer Distribution By Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(150)) %>%
cols_align("center")
| Singer Distribution By Group | ||
|---|---|---|
| singer_yn | n | percent_group |
| MTD | ||
| 0 | 34 | 47.89 |
| 1 | 37 | 52.11 |
| PVH | ||
| 0 | 12 | 31.58 |
| 1 | 24 | 63.16 |
| NA | 2 | 5.26 |
Only available for the voice disorder groups
df4c %>%
filter(survey == "MTD" | survey == "PVH") %>%
ggplot(aes(fct_infreq(survey))) +
geom_bar(color = "black",
fill = "#addd8e") +
theme_minimal() +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -.5)+
labs(title = "Diagnostic Group Count",
x = "Survey",
y = "Count") +
theme(plot.title = element_text(hjust = .5),
axis.title = element_text(size = 12,
face = "bold"),
axis.text = element_text(color = "black",
size = 10))
df4c %>%
filter(survey != "Control") %>%
group_by(dx) %>%
summarise(n = n(),
percent = round(n/nrow(filter(df4c, survey != "Control"))*100,2)) %>%
arrange(desc(n)) %>%
gt() %>%
tab_header(title = "Self-Reported DX - From Voice Centers") %>%
tab_options(table.align = "center") %>%
cols_width("dx" ~ px(250),
everything() ~ px(100)) %>%
cols_align("center")
| Self-Reported DX - From Voice Centers | ||
|---|---|---|
| dx | n | percent |
| Muscle tension dysphonia (MTD) | 48 | 44.04 |
| I do not know my diagnosis | 25 | 22.94 |
| Vocal fold polyp on one side (unilateral) | 11 | 10.09 |
| Benign-appearing vocal fold 'bumps' or lesions | 10 | 9.17 |
| Vocal fold nodules | 6 | 5.50 |
| Benign bilateral lesions | 2 | 1.83 |
| Vocal fold polyp (on one side, unilateral) | 2 | 1.83 |
| Diagnosis not listed | 1 | 0.92 |
| Mid membranous swelling | 1 | 0.92 |
| Vocal fold lesion | 1 | 0.92 |
| Vocal fold polyps (bilateral) | 1 | 0.92 |
| Vocal hyperfunction | 1 | 0.92 |
df4c %>%
group_by(survey) %>%
summarise(Mean = round(mean(score_vhi10, na.rm = T),2),
SD = round(sd(score_vhi10, na.rm = T),2),
Med = median(score_vhi10, na.rm = T),
Min = min(score_vhi10, na.rm = T),
Max = max(score_vhi10, na.rm = T)) %>%
gt() %>%
tab_header(title = "VHI-10 Distribution by Group") %>%
tab_options(table.align = "center") %>%
cols_width(everything() ~ px(120)) %>%
cols_align("center")
| VHI-10 Distribution by Group | |||||
|---|---|---|---|---|---|
| survey | Mean | SD | Med | Min | Max |
| Control | 1.38 | 1.14 | 1.0 | 0 | 3 |
| MTD | 18.99 | 8.67 | 18.0 | 4 | 40 |
| PVH | 17.89 | 9.72 | 18.5 | 0 | 40 |
Important note: These score distributions are the mean scores for each of the respective items. These average scores do not account for measurement error. The statistical analysis used for the current study examine group differences while accounting for measurement error and controling for the effects of age and sex.
Personality trait distributions
Equations in condensed notation for SEM
Parameter estimates for the fixed effects of age and sex
Parameter estimates for group differences on each trait
The current study replicated many of the findings using a contemporary and comprehensive personality theory and corresponding battery. Additionally, the current study leveraged SEM, a gold-standard analytic method used to study personality traits.
Although more work is necessary, these results address several key discrepancies between extant research into voice disorders and personality and current best practices in personality science.
Roy N, Bless DM. Personality traits and psychological factors in voice pathology: A foundation for future research. Journal of Speech, Language, and Hearing Research. 2000;43:737-748. doi:10.1044/jslhr.4303.737
Roy N, Bless D, Heisey D. Personality and voice disorders: A superfactor trait analysis. Journal of Speech, Language, and Hearing research. 2000;43(3):749-768.
Roy N, Bless DM, Heisey D. Personality and voice disorders: A multitrait-multidisorder analysis. Journal of Voice. 2000;14(4):521-548. doi:https://doi.org/10.1016/s0892-1997(00)80009-0
John OP. History, measurement, and conceptual elaboration of the Big-Five Trait Taxonomy: The paradigm matures. In: John OP, Robins RW, eds. The Handbook of Personality: Theory and Research. 4th ed. The Guilford Press; 2021:35-82.
DeYoung CG. Cybernetic Big Five Theory. J Res Pers. 2015;56:33-58. doi:10.1016/j.jrp.2014.07.004
DeYoung CG, Quilty LC, Peterson JB. Between facets and domains: 10 aspects of the Big Five. J Pers Soc Psychol. 2007;93(5):880-896. doi:10.1037/0022-3514.93.5.880
Simms LJ, Zelazny K, Williams TF, Bernstein L. Does the number of response options matter? Psychometric perspectives using personality questionnaire data. Psychol Assess. 2019;31(4):557-566. doi:10.1037/pas0000648.supp
Lee K, Ashton MC. Factor analysis in personality research. In: Robins RW, Fraley RC, Krueger RF, eds. Handbook of Research Methods in Personality Psychology. The Guilford Press; 2007:424-443.
Cohen J. The cost of dichotomization. Appl Psychol Meas. 1983;7(3):249-253. doi:10.1177/014662168300700301
Decoster J, Gallucci M, Iselin AMR. Best practices for using median splits, artificial categorization, and their continuous alternatives. Journal of Experimental Psychopathology JEP. 2011;2:197-209. doi:10.5127/jep.008310
McClelland GH, Lynch JG, Irwin JR, Spiller SA, Fitzsimons GJ. Median splits, Type II errors, and false-positive consumer psychology: Don’t fight the power. Journal of Consumer Psychology. 2015;25(4):679-689. doi:10.1016/j.jcps.2015.06.014
Derksen S, Keselman HJ. Backward, forward and stepwise automated subset selection algorithms: Frequency of obtaining authentic and noise variables. British Journal of Mathematical and Statistical Psychology. 1992;45(2):265-282. doi:10.1111/j.2044-8317.1992.tb00992.x
Smith G. Step away from stepwise. J Big Data. 2018;5(32):1-12. doi:10.1186/s40537-018-0143-6
Hoyle RH. Structural equation modeling: An overview. In: Hoyle RH, ed. Handbook of Structural Equation Modeling. 2nd ed. The Guilford Press; 2023:3-16.